home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / cfi_v607.zip / CFITEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  10KB  |  259 lines
  1. {$IFDEF Ver55}
  2. {$R-,S+,A-,D-,L-}
  3. {$ENDIF}
  4. {$IFDEF Ver50}
  5. {$R-,S+,A-,D-,L-}
  6. {$ENDIF}
  7. {$IFDEF Ver40}
  8. {$R-,S+,D-}
  9. {$ENDIF}
  10. PROGRAM CFITest;
  11. {******************************************************************************
  12. * TestCFI is supplied to give you a view at most of CFI's functions, this is  *
  13. * a straightforward program. To let even the starting programmers read the    *
  14. * source easy, I have used no special tricks whatsoever.                      *
  15. * You can modify the program to your own needs or better, you can use some of *
  16. * the code as a setup for your own program !                                  *
  17. ******************************************************************************}
  18.  
  19. USES
  20.    Crt,Dos,{$IFDEF Ver40}T4CFI{$ENDIF}{$IFDEF Ver50}T5CFI{$ENDIF}{$IFDEF Ver55}T55CFI{$ENDIF};
  21.  
  22. VAR
  23.    InputP,InputT                                        :STRING;
  24.    InputC                                               :CHAR;
  25.    ArcRec                                               :CIRTyp;
  26.    NewAtt                                               :BYTE;
  27.    DatTim                                               :DATETIME;
  28.  
  29. FUNCTION  Compressed_Type(Attrib:BYTE):STRING;
  30. {******************************************************************************
  31. *  Function to translate the CIRAtr byte into meaningfull text                *
  32. ******************************************************************************}
  33. BEGIN
  34.    CASE Attrib OF
  35.       1..2:Compressed_Type:='SEA stored)';
  36.       3   :Compressed_Type:='SEA packed)';
  37.       4   :Compressed_Type:='SEA Squeezed)';
  38.       5..8:Compressed_Type:='SEA Crunched)';
  39.       9   :Compressed_Type:='PKWare (old) Squashed)';
  40.       10  :Compressed_Type:='NoGate Crushed)';
  41.       11  :Compressed_Type:='NoGate Destilled)';
  42.       45  :Compressed_Type:='Nogate archive-comment)';
  43.       46  :Compressed_Type:='Nogate file-comment)';
  44.       47  :Compressed_Type:='Nogate file path   )';
  45.       48  :Compressed_Type:='Nogate Security enveloppe)';
  46.       49  :Compressed_Type:='Nogate Error correction)';
  47.       50  :Compressed_Type:='ZIP (local header) Stored))';
  48.       51  :Compressed_Type:='ZIP (local header) Shrunk)';
  49.       52  :Compressed_Type:='ZIP (local header) Reduced-1)';
  50.       53  :Compressed_Type:='ZIP (local header) Reduced-2)';
  51.       54  :Compressed_Type:='ZIP (local header) Reduced-3)';
  52.       55  :Compressed_Type:='ZIP (local header) Reduced-4)';
  53.       56  :Compressed_Type:='ZIP (local header) Implodede';
  54.       80  :Compressed_Type:='ZIP (central header) Stored)';
  55.       81  :Compressed_Type:='ZIP (central header) Shrunk)';
  56.       82  :Compressed_Type:='ZIP (central header) Reduced-1)';
  57.       83  :Compressed_Type:='ZIP (central header) Reduced-2)';
  58.       84  :Compressed_Type:='ZIP (central header) Reduced-3)';
  59.       85  :Compressed_Type:='ZIP (central header) Reduced-4)';
  60.       86  :Compressed_Type:='ZIP (central header) Imploded';
  61.       99  :Compressed_Type:='ZIP End_of_central directory)';
  62.       100 :Compressed_Type:='ZOO Stored)';
  63.       101 :Compressed_Type:='ZOO LWZ compression)';
  64.       150 :Compressed_Type:='ZOO (deleted) Stored)';
  65.       151 :Compressed_Type:='ZOO (deleted) LWZ compression)';
  66.       200 :Compressed_Type:='ICE stored)';
  67.       201 :Compressed_Type:='ICE LZHufman)';
  68.       202 :Compressed_Type:='ICE/LZS -lz4-)';
  69.       203 :Compressed_Type:='ICE/LZS -lz5-)';
  70.       230 :Compressed_Type:='ICE/LZS -lz0-)';
  71.       231 :Compressed_Type:='ICE/LZS -lz1-)';
  72.       232 :Compressed_Type:='ICE/LZS -lz2-)';
  73.       234 :Compressed_Type:='ICE/LZS -lz3-)';
  74.       249 :Compressed_Type:='ICE/LZS -lz?-)';
  75.       255 :Compressed_Type:='DWC stored)';
  76.       251 :Compressed_Type:='DWC crunched)';
  77.       else Compressed_Type:='Unknown)';
  78.    END;
  79. END;
  80.  
  81. PROCEDURE Print_Information;
  82. {******************************************************************************
  83. *  Print the information obtained from CFI                                    *
  84. ******************************************************************************}
  85. BEGIN
  86.    ClrScr;
  87.    Writeln('Next Entry');
  88.    Writeln('-----------------------------------------------------------------------------');
  89.    Writeln('Attribute       : ',ArcRec.CirAtr,' (',Compressed_Type(ArcRec.CirAtr));
  90.    Writeln('Internal flag 1 : ',ArcRec.CIRFl1);
  91.    Writeln('Internal flag 2 : ',ArcRec.CIRFl1);
  92.    Writeln('Filename        : ',ArcRec.CIRNam);
  93.    Writeln('Path            : ',ArcRec.CIRPth);
  94.    Writeln('Extra field     : ',ArcRec.CIRExt);
  95.    Writeln('Description     : ',ArcRec.CIRDes);
  96.    Writeln('Original   size : ',ArcRec.CIROSi);
  97.    Writeln('Compressed size : ',ArcRec.CIRASi);
  98.    UnpackTime(ArcRec.CIRDTm,DatTim);
  99.    InputP:='Date : ';
  100.    Str(DatTim.Month,InputT);IF Length(InputT)=1 THEN InputT:='0'+InputT;
  101.    InputP:=InputP+InputT+'/';
  102.    Str(DatTim.Day,InputT);  IF Length(InputT)=1 THEN InputT:='0'+InputT;
  103.    InputP:=InputP+InputT+'/';
  104.    Str(DatTim.Year,InputT);Delete(InputT,1,2);
  105.    InputP:=InputP+InputT+'   Time : ';
  106.    Str(DatTim.Hour,InputT); IF Length(InputT)=1 THEN InputT:='0'+InputT;
  107.    InputP:=InputP+InputT+':';
  108.    Str(DatTim.Min,InputT);  IF Length(InputT)=1 THEN InputT:='0'+InputT;
  109.    InputP:=InputP+InputT+':';
  110.    Str(DatTim.Sec,InputT);  IF Length(InputT)=1 THEN InputT:='0'+InputT;
  111.    InputP:=InputP+InputT;
  112.    Writeln('Time/date       : ',ArcRec.CIRDTm,'   ',InputP);
  113.    Writeln('CRC             : ',ArcRec.CIRCRC);
  114.    Writeln('File attribute  : ',ArcRec.CIRFAt);
  115.    Writeln('Cum. orig. size : ',CFlOSi);
  116.    Writeln('Cum. comp. size : ',CFlASi);
  117.    Writeln('Zero-based start: ',ArcRec.CIRSpo);
  118.    Writeln('Lengt (hea+data): ',ArcRec.CIRLen);
  119.    TextColor(Yellow);
  120.    Write('Hit <ENTER> key to continue with next entry --> ');
  121.    TextColor(LightGray);
  122.    REPEAT InputC:=Readkey UNTIL InputC=#13;
  123. END;
  124.  
  125. BEGIN
  126.    TextColor(LightGray);TextBackGround(Black);
  127.    ClrScr;
  128.    Writeln('TEST_CFI V 6.02   Test CFI interface  (c) 1989 Robert W. van Hoeven/Nederland');
  129.    Writeln('-----------------------------------------------------------------------------');
  130.    Writeln;
  131.    Window(1,4,80,24);
  132.    Writeln('Testing copyrights and internal structure ...  ');
  133.    Writeln;
  134.    TextColor(Cyan);
  135.    Writeln(CflCpy);
  136.    TextColor(LightGray);
  137.    Writeln;
  138.    Writeln('Current CFI version: ',CflVer);
  139.    Writeln;
  140.    TextColor(Yellow);
  141.    Write('Hit <ENTER> to continue --> ');
  142.    TextColor(LightGray);
  143.    REPEAT InputC:=ReadKey UNTIL InputC=#13;
  144.    ClrScr;
  145.    Write(#7,'--> Test the ');
  146.    TextColor(LightGreen);Write('NORMAL');TextColor(LightGray);
  147.    Writeln(' open function and list all entries of file <--');
  148.    Window(1,6,80,24);
  149.    REPEAT
  150.       ClrScr;
  151.       Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
  152.       Write('--> ');Readln(InputP);
  153.       IF InputP<>'' THEN BEGIN
  154.      IF Open_CFL(InputP) THEN BEGIN
  155.         WHILE Next_CFL(ArcRec) DO Print_Information;
  156.             Clos_CFL;
  157.      END ELSE BEGIN
  158.         TextColor(LightRed);
  159.         Writeln;
  160.         Writeln;
  161.         Writeln(#7,'File is not avaliable or no archive !');
  162.         Writeln;
  163.         TextColor(Yellow);
  164.         Write('Hit <ENTER> key to continue with next entry --> ');
  165.         TextColor(LightGray);
  166.         REPEAT InputC:=Readkey UNTIL InputC=#13;
  167.          END;
  168.       END;
  169.    UNTIL InputP='';
  170.    Window(1,4,80,24);
  171.    ClrScr;
  172.    Write(#7,'--> Test the ');
  173.    TextColor(LightRed);Write('FORCED');TextColor(LightGray);
  174.    Writeln(' open function and list all entries of file <--');
  175.    Window(1,6,80,24);
  176.    REPEAT
  177.       ClrScr;
  178.       Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
  179.       Write('--> ');Readln(InputP);
  180.       IF inputP<>'' THEN BEGIN
  181.          NewAtt:=Test_CFL(InputP);
  182.          IF NewAtt>0 THEN BEGIN
  183.         IF Forc_CFL(InputP,NewAtt) THEN BEGIN
  184.            WHILE Next_CFL(ArcRec) DO Print_Information;
  185.                Clos_CFL;
  186.         END ELSE BEGIN
  187.            TextColor(LightRed);
  188.            Writeln;
  189.            Writeln;
  190.            Writeln(#7,'File is not avaliable or no archive !');
  191.            Writeln;
  192.            TextColor(Yellow);
  193.            Write('Hit <ENTER> key to continue with next entry --> ');
  194.            TextColor(LightGray);
  195.            REPEAT InputC:=Readkey UNTIL InputC=#13;
  196.             END;
  197.      END ELSE BEGIN
  198.         TextColor(LightRed);
  199.         Writeln;
  200.         Writeln;
  201.         Writeln(#7,'File is not an archive supported by CFI or is invalid !');
  202.         Writeln;
  203.         TextColor(Yellow);
  204.         Write('Hit <ENTER> key to continue with next entry --> ');
  205.         TextColor(LightGray);
  206.         REPEAT InputC:=Readkey UNTIL InputC=#13;
  207.          END;
  208.       END;
  209.    UNTIL InputP='';
  210.    Window(1,4,80,24);
  211.    ClrScr;
  212.    Write(#7,'--> Test the ');
  213.    TextColor(Yellow);Write('LONG');TextColor(LightGray);
  214.    Writeln(' open function and list all entries of file <--');
  215.    Window(1,6,80,24);
  216.    {---------- For SXF testing and invalid headers set CflSFX to TRUE --------}
  217.    CFlSFX:=TRUE;
  218.    {--------------------------------------------------------------------------}
  219.    REPEAT
  220.       ClrScr;
  221.       Writeln('Enter name (optional path) of a normal compressed file (no name to halt)');
  222.       Write('--> ');Readln(InputP);
  223.       IF inputP<>'' THEN BEGIN
  224.      NewAtt:=Test_CFL(InputP);
  225.          IF NewAtt>0 THEN BEGIN
  226.         IF Forc_CFL(InputP,NewAtt) THEN BEGIN
  227.            WHILE Next_CFL(ArcRec) DO Print_Information;
  228.                Clos_CFL;
  229.         END ELSE BEGIN
  230.            TextColor(LightRed);
  231.            Writeln;
  232.            Writeln;
  233.            Writeln(#7,'File is not avaliable or no archive !');
  234.            Writeln;
  235.            TextColor(Yellow);
  236.            Write('Hit <ENTER> key to continue with next entry --> ');
  237.            TextColor(LightGray);
  238.            REPEAT InputC:=Readkey UNTIL InputC=#13;
  239.             END;
  240.      END ELSE BEGIN
  241.         TextColor(LightRed);
  242.         Writeln;
  243.         Writeln;
  244.         Writeln(#7,'File is not an archive supported by CFI or is invalid !');
  245.         Writeln;
  246.         TextColor(Yellow);
  247.         Write('Hit <ENTER> key to continue with next entry --> ');
  248.         TextColor(LightGray);
  249.         REPEAT InputC:=Readkey UNTIL InputC=#13;
  250.          END;
  251.       END;
  252.    UNTIL InputP='';
  253.    Window(1,1,80,25);
  254.    ClrScr;
  255.    Writeln('TestCFI ended !');
  256.    NormVideo;
  257. END.
  258.  
  259.